home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / SayNumber.f < prev    next >
Encoding:
FORTH Source  |  1989-06-08  |  2.5 KB  |  138 lines
  1. \ Pronounce a given number in decimal
  2. \
  3. \ Mike Haas, 04-oct-88
  4.  
  5.  
  6. include? speak ju:speak
  7.  
  8. anew task-SayNumber.f
  9.  
  10.  
  11. \ ====================  the program  ========================
  12.  
  13.  
  14. variable   1Billions
  15. variable 100Millions
  16. variable  10Millions
  17. variable   1Millions
  18. variable 100Thousands
  19. variable  10Thousands
  20. variable   1Thousands
  21. variable 100s
  22. variable  10s
  23. variable   1s
  24. variable Total
  25. variable IsNegative
  26.  
  27. decimal
  28.  
  29. variable NString  252 allot
  30.  
  31. : DivideNumber   ( n1 -- , split into decimal component parts )
  32.   dup 0< IsNegative ! abs
  33.   1,000,000,000 /mod   1Billions  !
  34.       1,000,000 /mod   1Millions  !
  35.           1,000 /mod   1Thousands !
  36.                        1s         !
  37. ;
  38.  
  39. : >NString  ( $adr $cnt -- )
  40.   NString $append
  41. ;
  42.  
  43. : .Teen  ( 9<N<20 -- )
  44.   CASE
  45.      0  OF   " ten"         ENDOF
  46.      1  OF   " elehven"      ENDOF
  47.      2  OF   " twelve"      ENDOF
  48.      3  OF   " thirteen"    ENDOF
  49.      4  OF   " 4teen"       ENDOF
  50.      5  OF   " fifteen"     ENDOF
  51.      6  OF   " 6teen"       ENDOF
  52.      7  OF   " 7teen"       ENDOF
  53.      8  OF   " 8teen"       ENDOF
  54.      9  OF   " 9teen"       ENDOF
  55.   ENDCASE
  56.   count >NString
  57. ;
  58.  
  59. : .Tens  ( 0<N<10 -- )
  60.   CASE
  61.      2  OF   " twentee "      ENDOF
  62.      3  OF   " thirtee "    ENDOF
  63.      4  OF   " 4tee "       ENDOF
  64.      5  OF   " fiftee "     ENDOF
  65.      6  OF   " 6tee "       ENDOF
  66.      7  OF   " 7tee "       ENDOF
  67.      8  OF   " 8tee "       ENDOF
  68.      9  OF   " 9tee "       ENDOF
  69.   ENDCASE
  70.   count >NString
  71. ;
  72.  
  73. : .Triplet  ( 0<=N<=999 -- )
  74.   100 /mod ?dup
  75.   IF
  76.      n>text >NString  "  hundred " count >NString
  77.   THEN
  78.   ?dup
  79.   IF
  80.      10 /mod dup 2 <
  81.      IF
  82.         1 <
  83.         IF
  84.            n>text >NString
  85.         ELSE
  86.            .Teen
  87.         THEN
  88.      ELSE
  89.         .Tens  ?dup
  90.         IF
  91.            n>text >NString
  92.         THEN
  93.      THEN
  94.   THEN
  95.   "  " count >NString
  96. ;
  97.  
  98.    
  99. : SayNum  ( -- , <text> )  intuition?  speak.init
  100.   NString off
  101.   bl word decimal number?
  102.   IF
  103.      drop  dup Total !
  104.      DivideNumber
  105.      IsNegative @
  106.      IF
  107.         " negative "  count >NString
  108.      THEN
  109.      1Billions @ ?dup
  110.      IF
  111.         .triplet " Billion "  count >NString
  112.      THEN
  113.      1Millions @ ?dup
  114.      IF
  115.         .triplet " Million "  count >NString
  116.      THEN
  117.      1Thousands @ ?dup
  118.      IF
  119.         .triplet " Thousand "  count >NString
  120.      THEN
  121.      1s @ ?dup
  122.      IF
  123.         .triplet
  124.      ELSE
  125.         Total @ 0=
  126.         IF
  127.            " zero"  count >NString
  128.         THEN
  129.      THEN
  130.      NString speak
  131.   ELSE
  132.      >newline
  133.      here $type  "  is not a decimal number"  dup $type cr
  134.      here speak  speak
  135.   THEN
  136.   speak.term
  137. ;  
  138.